home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / elk-2_0.lha / elk-2.0 / lib / xm / list.d < prev    next >
Encoding:
Text File  |  1989-10-12  |  2.1 KB  |  76 lines
  1. ;;; -*-Scheme-*-
  2.  
  3. (define-widget-type 'list "List.h")
  4.  
  5. (define-widget-class 'list 'xmListWidgetClass)
  6.  
  7. (prolog
  8.  
  9. "static Object String_Table_To_Scheme (tab, len) XmString *tab; {
  10.     Object ret, tail;
  11.     char *text;
  12.     GC_Node2;
  13.  
  14.     tail = ret = P_Make_List (Make_Fixnum (len), Null);
  15.     GC_Link2 (ret, tail);
  16.     for ( ; len > 0; len--, tail = Cdr (tail)) {
  17.     if (!XmStringGetLtoR (*tab++, XmSTRING_DEFAULT_CHARSET, &text))
  18.         text = \"\";
  19.     Car (tail) = Make_String (text, strlen (text));
  20.     }
  21.     GC_Unlink;
  22.     return ret;
  23. }")
  24.  
  25. (prolog
  26.  
  27. "static SYMDESCR Type_Syms[] = {
  28.    { \"initial\",      XmINITIAL },
  29.    { \"modification\", XmMODIFICATION },
  30.    { \"addition\",     XmADDITION },
  31.    { 0, 0}
  32. };")
  33.  
  34. (prolog
  35.  
  36. "static Object Get_List_CB (p) XmListCallbackStruct *p; {
  37.     Object ret, s;
  38.     char *text;
  39.     GC_Node2;
  40.  
  41.     if (!XmStringGetLtoR (p->item, XmSTRING_DEFAULT_CHARSET, &text))
  42.     text = \"\";
  43.     ret = s = Make_String (text, strlen (text));
  44.     GC_Link2 (ret, s);
  45.     ret = Cons (ret, Null);
  46.     if (p->reason == XmCR_MULTIPLE_SELECT
  47.         || p->reason == XmCR_EXTENDED_SELECT) {
  48.     s = String_Table_To_Scheme (p->selected_items, p->selected_item_count);
  49.     ret = Cons (s, ret);
  50.     s = Bits_To_Symbols ((unsigned long)p->selection_type, 0, Type_Syms);
  51.     ret = Cons (s, ret);
  52.     } else {
  53.     ret = Cons (Make_Integer (p->item_position), ret);
  54.     }
  55.     s = Get_Any_CB ((XmAnyCallbackStruct *)p);
  56.     ret = Cons (Cdr (s), ret);
  57.     ret = Cons (Car (s), ret);
  58.     GC_Unlink;
  59.     return ret;
  60. }")
  61.  
  62. (define-callback 'list 'browseSelectionCallback   #t)
  63. (define-callback 'list 'defaultActionCallback     #t)
  64. (define-callback 'list 'extendedSelectionCallback #t)
  65. (define-callback 'list 'multipleSelectionCallback #t)
  66. (define-callback 'list 'singleSelectionCallback   #t)
  67.  
  68. (define list-callback->scheme
  69. "   return Get_List_CB ((XmListCallbackStruct *)x);")
  70.  
  71. (c->scheme 'list-browseSelectionCallback   list-callback->scheme)
  72. (c->scheme 'list-defaultActionCallback     list-callback->scheme)
  73. (c->scheme 'list-extendedSelectionCallback list-callback->scheme)
  74. (c->scheme 'list-multipleSelectionCallback list-callback->scheme)
  75. (c->scheme 'list-singleSelectionCallback   list-callback->scheme)
  76.